VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Spin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Private rChangeRate As Long
Private rEnabled As Boolean
Private WithEvents Up As ComboPack.Button
Attribute Up.VB_VarHelpID = -1
Private WithEvents Down As ComboPack.Button
Attribute Down.VB_VarHelpID = -1
Private rForeColor As Long
Private rBackColor As Long
Private rLeft As Single
Private rTop As Single
Private rWidth As Single
Private rHeight As Single
Private rMinValue As Long
Private rMaxValue As Long
Private rValue As Long
Public Parent As Object
Public Event Click()
Public Event Resize()
Public Event Changed(PropertyName As String)
Public Event PositionChange(NewLeft As Single, _
NewTop As Single)
Public Event MouseDown(Button As Integer, X As _
    Single, Y As Single)
Public Event MouseMove(Button As Integer, X As _
    Single, Y As Single)
Public Event MouseUp(Button As Integer, X As _
    Single, Y As Single)
Public Property Let MaxValue(ByVal vData As Long)
    rMaxValue = vData
End Property
Public Property Get MaxValue() As Long
    MaxValue = rMaxValue
End Property
Public Property Let MinValue(ByVal vValue As Long)
Attribute MinValue.VB_Description = "Returns/sets the Minimum value that the object displays."
    rMinValue = vValue
End Property
Public Property Get MinValue() As Long
    MinValue = rMinValue
End Property
Public Property Let Height(ByVal vValue As Single)
    rHeight = vValue
    Changed "Size"
End Property
Public Property Get Height() As Single
    Height = rHeight
End Property
Public Property Let Width(ByVal vValue As Single)
    rWidth = vValue
    Changed "Size"
End Property
Public Property Get Width() As Single
    Width = rWidth
End Property

Public Property Let Top(ByVal vValue As Single)
    rTop = vValue
    Changed "Position"
End Property

Public Property Get Top() As Single
    Top = rTop
End Property

Public Property Let Left(ByVal vValue As Single)
    rLeft = vValue
    Changed "Position"
End Property
Public Property Get Left() As Single
    Left = rLeft
End Property

Public Property Get ForeColor() As Long
    ForeColor = rForeColor
End Property
Public Property Let ForeColor(vForeColor As Long)
    rForeColor = vForeColor
    Changed "Color"
End Property
Public Sub Changed(Name As String)
Select Case Name
    Case "Size"
        Redraw
        ResizeControls
        RaiseEvent Resize
    Case "Position"
        RaiseEvent PositionChange(Left, Top)
End Select
RaiseEvent Changed(Name)
End Sub
Public Sub MouseDown(Button As Integer, X As Single, Y As Single)
    Up.MouseDown Button, X, Y
    Down.MouseDown Button, X, Y
    RaiseEvent MouseDown(Button, X - Left, Y - Top)
End Sub
Public Sub MouseMove(Button As Integer, X As Single, Y As Single)
    Up.MouseMove Button, X, Y
    Down.MouseMove Button, X, Y
    RaiseEvent MouseMove(Button, X - Left, Y - Top)
End Sub
Public Sub MouseUp(Button As Integer, X As Single, Y As Single)
    If InScope(X, Y) And Button = 1 Then
        RaiseEvent Click
    End If
    Up.MouseUp Button, X, Y
    Down.MouseUp Button, X, Y
    RaiseEvent MouseUp(Button, X - Left, Y - Top)
End Sub

Private Sub Class_Initialize()
    BackColor = vbButtonFace
    CreateControls
End Sub

Private Sub Class_Terminate()
    Set Up = Nothing
    Set Down = Nothing
End Sub

Public Sub Redraw()
    Dim m_intDWid As Integer
    On Error Resume Next
    m_intDWid = Parent.DrawWidth
    Parent.DrawWidth = 1
    If Up Is Nothing Then
        CreateControls
        ResizeControls
    End If
    Up.BackColor = BackColor
    Down.BackColor = BackColor
    Set Down.Parent = Parent
    Set Up.Parent = Parent
    DrawBox Parent, Left, Top, Width - 280, Height, True, True, BackColor
    Parent.CurrentX = Left + (Width - 700) - Parent.TextWidth(Value)
    Parent.CurrentY = Top + (Height / 2 - Parent.TextHeight(Value) / 2)
    Parent.Print Value
    Up.Redraw
    Down.Redraw
    Parent.DrawWidth = m_intDWid
    CheckEnable Value
End Sub

Private Sub ResizeControls()
On Error Resume Next
    With Down
        .Left = Left + Width - 300
        .Top = Top
        .Width = 300
        .Height = Height
        Set .Font = New StdFont
        .Font.Size = Parent.Font.Size
        .Font.Bold = Parent.Font.Bold
        .Font.Italic = Parent.Font.Italic
        .Font.Charset = Parent.Font.Charset
        .Font.Strikethrough = Parent.Font.Strikethrough
        .Font.Name = "Symbol"
        .Caption = Chr(223)
        .Enabled = Enabled
    End With
    With Up
        .Left = Left + Width - 600
        .Top = Top
        .Width = 300
        .Height = Height
        Set .Font = New StdFont
        .Font.Size = Parent.Font.Size
        .Font.Bold = Parent.Font.Bold
        .Font.Italic = Parent.Font.Italic
        .Font.Charset = Parent.Font.Charset
        .Font.Strikethrough = Parent.Font.Strikethrough
        .Font.Name = "Symbol"
        .Caption = Chr(221)
        .Enabled = Enabled
    End With
End Sub

Private Sub CreateControls()
    Set Down = New ComboPack.Button
    Set Up = New ComboPack.Button
End Sub

Public Sub Move(Left As Single, Optional Top As Single, Optional Width As Single, Optional Height As Single)
    If Left > 0 Then Me.Left = Left
    If Top > 0 Then Me.Top = Top
    If Width > 0 Then Me.Width = Width
    If Height > 0 Then Me.Height = Height
End Sub

Public Property Get Enabled() As Boolean
    Enabled = rEnabled
End Property

Public Property Let Enabled(ByVal vEnabled As Boolean)
    rEnabled = vEnabled
    Changed "Enabled"
End Property

Public Property Get Value() As Long
Attribute Value.VB_UserMemId = 0
    Value = rValue
End Property

Public Property Let Value(ByVal vValue As Long)
    CheckEnable vValue
    rValue = vValue
    Changed "Value"
    Redraw
End Property
Public Property Get BackColor() As Long
    BackColor = rBackColor
End Property
Public Property Let BackColor(ByVal vBackColor As Long)
    rBackColor = vBackColor
    Redraw
    Changed "Color"
    On Error Resume Next
    Up.BackColor = vBackColor
    Down.BackColor = vBackColor
End Property

Public Property Get ChangeRate() As Long
ChangeRate = rChangeRate
End Property

Public Property Let ChangeRate(ByVal vChangeRate As Long)
rChangeRate = vChangeRate
Changed "Rate"
End Property

Private Sub Down_Press()
Static Press As Long
Do Until Not Down.Pressed
DoEvents
Press = Press + 1
If Press = 5000 Then
Value = Value - ChangeRate
Press = 0
End If
Loop
Press = 0
End Sub

Private Sub Up_Press()
Static Press As Long
Do Until Not Up.Pressed
DoEvents
Press = Press + 1
If Press = 5000 Then
Value = Value + ChangeRate
Press = 0
End If
Loop
Press = 0
End Sub
Public Function InScope(X As Single, Y As Single)
'Checks the X and Y of the event that calls it, _
VERY Simple Function
InScope = ((X - Left) > 0 And (X - Left) < Width) And ((Y - Top) > 0 And (Y - Top) < Height)
End Function



Private Sub CheckEnable(vValue As Long)
    If vValue <= MinValue Then
        vValue = MinValue
        Down.Enabled = False
    Else
        If Not Down.Enabled Then
            Down.Enabled = True
        End If
    End If
    If vValue >= MaxValue Then
        vValue = MaxValue
        Up.Enabled = False
    Else
        If Not Up.Enabled Then
            Up.Enabled = True
        End If
    End If
End Sub
